home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Oberon
/
source
/
Kernel
/
Kernel_1.4.mod
< prev
next >
Wrap
Text File
|
1995-06-04
|
7KB
|
226 lines
(**************************************************************************
$RCSfile: Kernel_1.4.mod $
Description: Oberon-A run-time support module.
Created by: fjc (Frank Copeland)
$Revision: 1.3 $
$Author: fjc $
$Date: 1994/11/11 16:48:27 $
Copyright © 1994, Frank Copeland.
This file is part of Oberon-A.
See Oberon-A.doc for conditions of use and distribution.
_________________________________________________________________________
Module Kernel will have a unique status in the Oberon-A system,
starting with Release 1.5. It will implement the startup and exit code
for each program, as well as the run-time support code for standard
procedures such as NEW that are too large or complex to be generated
inline by the compiler. Currently these tasks are handled by the code
in OberonSys.lib, which is written in assembly language. However, this
will require changes to the compiler to remove defunct procedures in
module SYSTEM and to change hard-coded assumptions about the calling
conventions and linker symbols of procedures in the run-time support
code.
This module is provided to help smooth the transition, without waiting
for Release 1.5. It provides what will hopefully be close to the
interface to the final module Kernel, but uses the features of the
current Release 1.4 module SYSTEM to implement them.
Existing code should be modified now to use module Kernel instead of
the extended features that are due to be removed from module SYSTEM.
These are:
SYSTEM.ARGLEN and SYSTEM.ARGS -- replace with the fromWorkbench,
dosCmdBuf, dosCmdLen and WBenchMsg variables exported by module
Kernel.
SYSTEM.SETCLEANUP -- replace with Kernel.SetCleanup.
SYSTEM.GC -- replace with Kernel.GC.
SYSTEM.GETNAME -- replace with Kernel.Name.
SYSTEM.SIZETAG -- replace with Kernel.Size.
SYSTEM.NEWTAG -- replace with Kernel.NewFromTag.
SYSTEM.NEW -- when using the optional memory requirements parameter,
use Kernel.New.
**************************************************************************)
<* STANDARD- *>
<* INITIALISE- *>
<* MAIN- *>
MODULE Kernel ["OberonSys.lib"];
(* Turn off ALL compiler checks. *)
<*$ CaseChk- IndexChk- NilChk- RangeChk- StackChk- TypeChk- OvflChk- *>
IMPORT SYS := SYSTEM;
TYPE
STRPTR = POINTER [1] TO ARRAY 32767 OF CHAR;
(*-----------------------------------------------------------------------**
** These variables are used to hold the arguments passed to the program **
** by AmigaDOS or Workbench. Do NOT make them writeable. **
**-----------------------------------------------------------------------*)
VAR
fromWorkbench -: BOOLEAN; (* TRUE if the program was started from
** Workbench, FALSE if it was started by a
** Shell or CLI.
*)
dosCmdBuf -: STRPTR; (* When started from a Shell or CLI, this
** variable will hold the command line used
** to run the program. Only valid if
** fromWorkbench is FALSE.
*)
dosCmdLen -: LONGINT; (* The length in characters of the command
** line. Only valid if fromWorkbench is
** FALSE.
*)
WBenchMsg -: SYS.CPTR; (* The startup message sent to the program
** by Workbench. Only valid if fromWorkbench
** is TRUE. This must be cast to a
** Workbench.WBStartupPtr to gain access to
** the arguments.
*)
(*-----------------------------------------------------------------------**
** These types are used to implement the automatic cleanup system. **
**-----------------------------------------------------------------------*)
TYPE
CleanupProc * = PROCEDURE (VAR rc : LONGINT);
CleanupPtr = POINTER [1] TO CleanupRec;
CleanupRec = RECORD [1]
link : CleanupPtr;
proc : CleanupProc;
END; (* CleanupRec *)
(*-----------------------------------------------------------------------**
** This variable is used to hold the list of installed cleanup **
** procedures. **
**-----------------------------------------------------------------------*)
VAR
cleanupList : CleanupPtr;
(*-----------------------------------------------------------------------*)
PROCEDURE* DoCleanup;
VAR rc : LONGINT; cleanupPtr : CleanupPtr;
BEGIN (* DoCleanup *)
(* Execute any installed cleanup procedures. *)
rc := SYS.RC(); cleanupPtr := cleanupList;
cleanupList := NIL; (* This avoids loops if an error occurs in a
** cleanup procedure.
*)
WHILE cleanupPtr # NIL DO
cleanupPtr.proc (rc);
cleanupPtr := cleanupPtr.link
END;
END DoCleanup;
(* SetCleanup() installs a procedure that will be executed automatically
** when the program exits.
*)
PROCEDURE SetCleanup * ( proc : CleanupProc );
VAR newCleanup : CleanupPtr;
BEGIN (* SetCleanup *)
NEW (newCleanup); ASSERT (newCleanup # NIL, 25);
newCleanup.link := cleanupList; cleanupList := newCleanup;
newCleanup.proc := proc
END SetCleanup;
(* Size() returns the size in bytes of the record type whose type tag
** is passed as a parameter. The type tag is obtained by a call to
** SYSTEM.TAG.
*)
PROCEDURE Size * ( type : SYS.TYPETAG ) : LONGINT;
VAR size : LONGINT;
BEGIN (* Size *)
ASSERT (type # NIL, 132);
RETURN SYS.SIZETAG (type)
END Size;
(* Name() copies the name of the type whose type tag is passed as a
** parameter into a string variable. The type tag is obtained by a call to
** SYSTEM.TAG.
*)
PROCEDURE Name * ( type : SYS.TYPETAG; VAR buf : ARRAY OF CHAR );
BEGIN (* Name *)
ASSERT (type # NIL, 132);
SYS.GETNAME (type, buf)
END Name;
(* NewFromTag() allocates a new record from the type tag passed as a
** parameter. The type tag is obtained by a call to SYSTEM.TAG.
*)
PROCEDURE NewFromTag * ( VAR v : SYS.PTR; type : SYS.TYPETAG );
BEGIN (* NewFromTag *)
ASSERT (type # NIL, 132);
SYS.NEWTAG (v, type)
END NewFromTag;
(* New() allocates a block of memory, with a specific set of memory
** requirements. The memory requirements are the same as those used by
** Exec.AllocMem().
*)
PROCEDURE New * ( VAR v : SYS.CPTR; size : LONGINT; reqs : SET );
BEGIN (* New *)
SYS.NEW (v, size, reqs)
END New;
(*
** GC is a straight replacement for SYSTEM.GC
*)
PROCEDURE GC *;
BEGIN
SYS.GC
END GC;
BEGIN (* Kernel *)
SYS.ARGLEN (dosCmdLen);
fromWorkbench := (dosCmdLen < 0);
IF fromWorkbench THEN
dosCmdBuf := NIL;
SYS.ARGS (SYS.VAL (LONGINT, WBenchMsg))
ELSE
SYS.ARGS (SYS.VAL (LONGINT, dosCmdBuf));
WBenchMsg := NIL
END;
SYS.SETCLEANUP (DoCleanup)
END Kernel.